home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / jockguts.arc / WINTTT5.PAS < prev   
Pascal/Delphi Source File  |  1991-04-28  |  29KB  |  987 lines

  1. {--------------------------------------------------------------------------}
  2. {                         TechnoJock's Turbo Toolkit                       }
  3. {                                                                          }
  4. {                              Version   5.01                              }
  5. {                                                                          }
  6. {                                                                          }
  7. {              Copyright 1986, 1989 TechnoJock Software, Inc.              }
  8. {                           All Rights Reserved                            }
  9. {                          Restricted by License                           }
  10. {--------------------------------------------------------------------------}
  11.  
  12.                      {--------------------------------}
  13.                      {       Unit:   WinTTT5          }
  14.                      {--------------------------------}
  15.  
  16. {History:    03/05/89   5.00a  corrected Get_ScreenWord procedure
  17.              04/01/89   5.01   added DOS errorlevel 10 on fatal
  18.                                and corrected screen scroll
  19. }
  20.  
  21. {$S-,R-,V-,D-}       
  22.  
  23. unit  WinTTT5;
  24.  
  25. interface
  26.  
  27. uses CRT,DOS,FastTTT5,KeyTTT5;
  28.  
  29. Type
  30.  Direction = (Up, Down, Left, Right);
  31. Const
  32.     Shadow = 5;
  33. Var
  34.     Shadcolor    : byte;
  35.     DisplayLines : byte;
  36.  
  37. Procedure MoveFromScreen(var Source,Dest;Length:Word);
  38. Procedure MoveToScreen(var Source,Dest; Length:Word);
  39. Procedure SizeCursor(Top,Bot:byte);
  40. Procedure FindCursor(var X,Y,Top,Bot:byte);
  41. Procedure PosCursor(X,Y: integer);
  42. Procedure Fullcursor;
  43. Procedure HalfCursor;
  44. Procedure OnCursor;
  45. Procedure OffCursor;
  46. Procedure GotoXY(X,Y : byte);
  47. Function  WhereX: byte;
  48. Function  WhereY: byte;
  49. Function  GetScreenChar(X,Y:byte):char;
  50. Function  GetScreenAttr(X,Y:byte):byte;
  51. Procedure GetScreenStr(X1,X2,Y:byte;var  St:StrScreen);
  52. Procedure CreateScreen(Page:byte;Lines:byte);
  53. Procedure SaveScreen(Page:byte);
  54. Procedure RestoreScreen(Page:byte);
  55. Procedure PartRestoreScreen(Page,X1,Y1,X2,Y2,X,Y:byte);
  56. Procedure SlideRestoreScreen(Page:byte;Way:Direction);
  57. Procedure PartSlideRestoreScreen(Page:byte;Way:Direction;X1,Y1,X2,Y2:byte);
  58. Procedure DisposeScreen(Page:byte);
  59. Procedure SetCondensedLines;
  60. Procedure Set25Lines;
  61. Procedure CopyScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  62. Procedure MoveScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  63. Procedure Scroll(Way:direction;X1,Y1,X2,Y2:byte);
  64. Procedure PartSave(X1,Y1,X2,Y2:byte; VAR Dest);
  65. Procedure PartRestore(X1,Y1,X2,Y2:byte; VAR Source);
  66. Procedure Mkwin(x1,y1,x2,y2,F,B,boxtype:integer);
  67. Procedure GrowMkwin(x1,y1,x2,y2,F,B,boxtype:integer);
  68. Procedure Rmwin;
  69. Procedure FillScreen(X1,Y1,X2,Y2:byte; F,B:byte; C:char);
  70. Procedure TempMessageCh(X,Y,F,B:integer;St:strscreen;var Ch : char);
  71. Procedure TempMessage(X,Y,F,B:integer;St:strscreen);
  72. Procedure TempMessageBoxCh(X1,Y1,F,B,BoxType:integer;St:strscreen;var Ch : char);
  73. Procedure TempMessageBox(X1,Y1,F,B,BoxType:integer;St:strscreen);
  74. Procedure Activate_Visible_Screen;
  75. Procedure Activate_Virtual_Screen(Page:byte);
  76. Procedure Reset_StartUp_Mode;
  77.  
  78. Const
  79.     Max_Windows = 10;          {Change this constant as necessary}
  80.     Max_Screens = 10;          {Change this constant as necessary}
  81.     WindowCounter : byte = 0;
  82.     ScreenCounter : byte = 0;
  83.     ActiveVScreen: byte = 0;
  84.  
  85. Type
  86.     ScreenImage = record
  87.                        CursorX : byte;
  88.                        CursorY : byte;
  89.                        ScanTop : byte;
  90.                        ScanBot : byte;
  91.                        SavedLines:byte;
  92.                        ScreenPtr: pointer;
  93.                   end;
  94.     ScreenPtr = ^ScreenImage;
  95.     WindowImage = record
  96.                        ScreenPtr: Pointer;             {pointer to screen data}
  97.                        Coord    : array[1..4] of byte; {window coords}
  98.                        CursorX  : byte;                {cursor location}
  99.                        CursorY  : byte;
  100.                        ScanTop  : byte;                {cursor shape}
  101.                        ScanBot  : byte;
  102.                   end;
  103.     WindowPtr = ^WindowImage;
  104.  
  105. Var
  106.     Screen : array[1..Max_Screens] of ScreenPtr;
  107.     Win    : array[1..Max_Windows] of WindowPtr;
  108.     W_error: integer;     {Global error to report winTTT errors}
  109.     W_fatal: boolean;
  110.  
  111. IMPLEMENTATION
  112.  
  113. CONST
  114.     MonoAdr =$b000;
  115. VAR
  116.     StartTop,      {used to record initial screen state when program is run}
  117.     StartBot   : Byte;
  118.     StartMode  : word;
  119.  
  120. {$L WINTTT5}
  121.  
  122. {$F+}
  123.   Procedure MoveFromScreen(var Source,Dest;Length:Word); external;
  124.   Procedure MoveToScreen(var Source,Dest; Length:Word); external;
  125. {$F-}
  126.  
  127. Procedure WinTTT_Error(No : byte);
  128. {Updates W_error and optionally displays error message then halts program}
  129. var Msg : String;
  130. begin
  131.     W_error := No;
  132.     If W_fatal = true then
  133.     begin
  134.         Case No of
  135.         1 :  Msg := 'Max screens exceeded';
  136.         2 :  Msg := 'Max Windows Exceeded';
  137.         3 :  Msg := 'Insufficient memory to create screen';
  138.         4 :  Msg := 'Screen not saved cannot activate.';
  139.         5 :  Msg := 'Screen has not been created - cannot activate';
  140.         6 :  Msg := 'Screen has not been created - cannot dispose';
  141.         7 :  Msg := 'Screen has not been created - cannot restore';
  142.         8 :  Msg := 'Screen does not exist cannot clear';
  143.         9 :  Msg := 'Insufficient memory for Screen Copy/Move';
  144.         10:  Msg := 'Visible screen must be active for Window operations';
  145.         11:  Msg := 'Visible screen must be active for Message operations';
  146.         12:; {reserved for non-fatal error settings condensed mode}
  147.         13:  Msg := 'Can only save 25 screen lines - check CONST SavedLines';
  148.         else Msg := '?) -- Utterly confused';
  149.         end; {Case}
  150.         Msg := 'Fatal Error (WinTTT -- '+Msg;
  151.         Writeln(Msg);
  152.         Delay(5000);    {display long enough to read if child process}
  153.         Halt(11);       {returns DOS ERRORLEVEL 11}
  154.     end;
  155. end;
  156.  
  157. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  158. {                                                                     }
  159. {     V I S I B L E    a n d    V I R T U A L  P R O C E D U R E S    }
  160. {                                                                     }
  161. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  162. Procedure PartSave (X1,Y1,X2,Y2:byte; VAR Dest);
  163. {transfers data from active virtual screen to Dest}
  164. var
  165.    I,width : byte;
  166.    ScreenAdr: integer;
  167. begin
  168.     width := succ(X2- X1);
  169.     For I :=  Y1 to Y2 do
  170.     begin
  171.      ScreenAdr := Vofs + Pred(I)*160 + Pred(X1)*2;
  172.      MoveFromScreen(Mem[Vseg:ScreenAdr],
  173.                     Mem[seg(Dest):ofs(dest)+(I-Y1)*width*2],
  174.                     width);
  175.     end;
  176. end;
  177.  
  178. Procedure PartRestore (X1,Y1,X2,Y2:byte; VAR Source);
  179. {restores data from Source and transfers to active virtual screen}
  180. var
  181.    I,width : byte;
  182.    ScreenAdr: integer;
  183. begin
  184.     width := succ(X2- X1);
  185.     For I :=  Y1 to Y2 do
  186.     begin
  187.      ScreenAdr := Vofs + Pred(I)*160 + Pred(X1)*2;
  188.      MoveToScreen(Mem[Seg(Source):ofs(Source)+(I-Y1)*width*2],
  189.                   Mem[Vseg:ScreenAdr],
  190.                   width);
  191.     end;
  192. end;
  193.  
  194. Procedure FillScreen(X1,Y1,X2,Y2:byte; F,B:byte; C:char);
  195. var
  196.    I : integer;
  197.    S : string;
  198. begin
  199.     W_error := 0;
  200.     Attrib(X1,Y1,X2,Y2,F,B);
  201.     S := Replicate(Succ(X2-x1),C);
  202.     For I := Y1 to Y2 do
  203.         PlainWrite(X1,I,S);
  204. end;
  205.  
  206. Procedure GetScreenWord(X,Y:byte;var Attr:byte; var Ch : char);
  207. {updates vars Attr and Ch with attribute and character bytes in screen
  208.  location (X,Y) of the active screen}
  209. Type
  210.     ScreenWordRec = record
  211.                          Ch   : char;   {5.00a}
  212.                          Attr : byte;
  213.                     end;
  214. var
  215.    ScreenAdr: integer;
  216.    SW : ScreenWordRec;
  217. begin
  218.     ScreenAdr := Vofs + Pred(Y)*160 + Pred(X)*2;
  219.     MoveFromScreen(Mem[Vseg:ScreenAdr],mem[seg(SW):ofs(SW)],1);
  220.     Attr := SW.Attr;
  221.     Ch   := SW.Ch;
  222. end;
  223.  
  224. Function GetScreenChar(X,Y:byte):char;
  225. var
  226.    A : byte;
  227.    C : char;
  228. begin
  229.     GetScreenWord(X,Y,A,C);
  230.     GetScreenChar := C;
  231. end;
  232.  
  233. Function GetScreenAttr(X,Y:byte):byte;
  234. var
  235.    A : byte;
  236.    C : char;
  237. begin
  238.     GetScreenWord(X,Y,A,C);
  239.     GetScreenAttr := A;
  240. end;
  241.  
  242. Procedure GetScreenStr(X1,X2,Y:byte;var  St:StrScreen);
  243. var
  244.    I : integer;
  245. begin
  246.     St := '';
  247.     For I := X1 to X2 do
  248.         St := St + GetScreenChar(I,Y);
  249. end;
  250.  
  251. {++++++++++++++++++++++++++++++++++++++++++++++}
  252. {                                              }
  253. {         C U R S O R    R O U T I N E S       }
  254. {                                              }
  255. {++++++++++++++++++++++++++++++++++++++++++++++}
  256.  
  257. Procedure GotoXY(X,Y : byte);
  258. {intercepts normal Turbo GotoXY procedure, in case a virtual screen
  259.  is active.
  260. }
  261. begin
  262.     If VSeg = BaseOfScreen then
  263.        CRT.GotoXY(X,Y)
  264.     else
  265.        with Screen[ActiveVScreen]^ do
  266.        begin
  267.            CursorX := X;
  268.            CursorY := Y;
  269.        end; {with}
  270. end;  {proc GotoXY}
  271.  
  272. Function WhereX: byte;
  273. {intercepts normal Turbo WhereX procedure, in case a virtual screen
  274.  is active.
  275. }
  276. begin
  277.     If VSeg = BaseOfScreen then
  278.        WhereX := CRT.WhereX
  279.     else
  280.        with Screen[ActiveVScreen]^ do
  281.            WhereX := CursorX;
  282. end; {of func WhereX}
  283.  
  284. Function WhereY: byte;
  285. {intercepts normal Turbo WhereX procedure, in case a virtual screen
  286.  is active.
  287. }
  288. begin
  289.     If VSeg = BaseOfScreen then
  290.        WhereY := CRT.WhereY
  291.     else
  292.        with Screen[ActiveVScreen]^ do
  293.            WhereY := CursorY;
  294. end; {of func WhereY}
  295.  
  296. Procedure FindCursor(var X,Y,Top,Bot:byte);
  297. var
  298.    Reg : registers;
  299. begin
  300.   If VSeg = BaseOfScreen then    {visible screen is active}
  301.   begin   
  302.       Reg.Ax := $0F00;              {get page in Bx}
  303.       Intr($10,Reg);
  304.       Reg.Ax := $0300;
  305.       Intr($10,Reg);
  306.       With Reg do
  307.       begin
  308.         X := lo(Dx) + 1;
  309.         Y := hi(Dx) + 1;
  310.         Top := Hi(Cx) and $0F;
  311.         Bot := Lo(Cx) and $0F;
  312.       end;
  313.   end
  314.   else                            {virtual screen active}
  315.      with Screen[ActiveVScreen]^ do
  316.      begin
  317.          X := CursorX;
  318.          Y := CursorY;
  319.          Top := ScanTop;
  320.          Bot := ScanBot;
  321.      end;
  322. end;
  323.  
  324. Procedure PosCursor(X,Y: integer);
  325. var Reg : registers;
  326. begin
  327.     If VSeg = BaseOfScreen then    {visible screen is active}
  328.     begin   
  329.         Reg.Ax := $0F00;              {get page in Bx}
  330.         Intr($10,Reg);
  331.         with Reg do
  332.         begin
  333.           Ax := $0200;
  334.           Dx := ((Y-1) shl 8) or ((X-1) and $00FF);
  335.         end;
  336.         Intr($10,Reg);
  337.     end
  338.     else                           {virtual screen active}
  339.        with Screen[ActiveVScreen]^ do
  340.        begin
  341.            CursorX := X;
  342.            CursorY := Y;
  343.        end;
  344. end;
  345.  
  346. Procedure SizeCursor(Top,Bot:byte);
  347. var Reg : registers;
  348. begin
  349.     If VSeg = BaseOfScreen then    {visible screen is active}
  350.        with Reg do
  351.        begin
  352.          ax := 1 shl 8;
  353.          cx := Top shl 8 + Bot;
  354.          INTR($10,Reg);
  355.        end
  356.     else                           {virtual screen active}
  357.        with Screen[ActiveVScreen]^ do
  358.        begin
  359.            ScanTop := Top;
  360.            ScanBot := Bot;
  361.        end;
  362. end;
  363.  
  364. Procedure HalfCursor;
  365. begin
  366.     If BaseOfScreen = MonoAdr then    
  367.        SizeCursor(8,13)    
  368.     else
  369.        SizeCursor(4,7);    
  370. end; {Proc HalfCursor}
  371.  
  372. Procedure Fullcursor;
  373. begin
  374.     If BaseOfScreen = MonoAdr then
  375.        SizeCursor(0,13)
  376.     else
  377.        SizeCursor(0,7);
  378. end;
  379.  
  380. Procedure OnCursor;
  381. begin
  382.     If BaseOfScreen = MonoAdr then
  383.        SizeCursor(12,13)
  384.     else
  385.        SizeCursor(6,7);
  386. end;
  387.  
  388. Procedure OffCursor;
  389. begin
  390.     Sizecursor(14,0);
  391. end;
  392.  
  393. {++++++++++++++++++++++++++++++++++++++++++++++++++++}
  394. {                                                    }
  395. {   S C R E E N   S A V I N G  R O U T I N E S       }
  396. {                                                    }
  397. {++++++++++++++++++++++++++++++++++++++++++++++++++++}
  398.  
  399. Procedure DisposeScreen(Page:byte);
  400. {Free memory and set pointer to nil}
  401. begin
  402.     If Screen[Page] = nil then
  403.     begin
  404.        WinTTT_Error(6);
  405.        exit;
  406.     end
  407.     else
  408.        W_error := 0;
  409.     FreeMem(Screen[Page]^.ScreenPtr,Screen[Page]^.SavedLines*160);
  410.     Freemem(Screen[Page],SizeOf(Screen[Page]^));
  411.     Screen[page] := nil;
  412.     If ActiveVscreen = Page then
  413.        Activate_Visible_Screen;
  414.     dec(ScreenCounter);
  415. end;
  416.  
  417. Procedure SaveScreen(Page:byte);
  418. {Save screen display and cursor details}
  419. begin
  420.     If (Page > Max_Screens) then
  421.     begin
  422.       WinTTT_Error(1);
  423.       exit;
  424.     end;
  425.     If ((Screen[Page] <> nil) and (DisplayLines <> Screen[Page]^.SavedLines)) then
  426.         DisposeScreen(Page);
  427.     If Screen[Page] = nil then            {need to allocate memory}
  428.     begin
  429.         If MaxAvail < SizeOf(Screen[Page]^) then
  430.         begin
  431.             WinTTT_Error(3);
  432.             exit;
  433.         end;
  434.         GetMem(Screen[Page],SizeOf(Screen[Page]^));
  435.         If MaxAvail < DisplayLines*160 then     {do check in two parts 'cos Maxavail is not same as MemAvail}
  436.         begin
  437.             WinTTT_Error(3);
  438.             Freemem(Screen[Page],SizeOf(Screen[Page]^));
  439.             Screen[Page] := nil;
  440.             exit;
  441.         end;
  442.         GetMem(Screen[Page]^.ScreenPtr,DisplayLines*160);
  443.         Inc(ScreenCounter);
  444.     end;
  445.     With Screen[Page]^ do
  446.     begin
  447.        FindCursor(CursorX,CursorY,ScanTop,ScanBot);     {Save Cursor posn. and shape}
  448.        SavedLines := DisplayLines;
  449.        MoveFromScreen(Mem[BaseOfScreen:0],Screen[Page]^.ScreenPtr^,DisplayLines*80);
  450.     end;
  451.     W_error := 0;
  452. end;
  453.  
  454. Procedure RestoreScreen(Page:byte);
  455. {Display a screen that was previously saved}
  456. begin
  457.     If Screen[Page] = nil then
  458.     begin
  459.        WinTTT_Error(7);
  460.        exit;
  461.     end
  462.     else
  463.        W_error := 0;
  464.     With Screen[Page]^ do
  465.     begin
  466.         MoveToScreen(ScreenPtr^,mem[BaseOfScreen:0], 80*SavedLines);
  467.         PosCursor(CursorX,CursorY);
  468.         SizeCursor(ScanTop,ScanBot);
  469.     end;
  470. end;  {Proc RestoreScreen}
  471.  
  472.  
  473. Procedure PartRestoreScreen(Page,X1,Y1,X2,Y2,X,Y:byte);
  474. {Move from heap to screen, part of saved screen}
  475. Var
  476.    I,width     : byte;
  477.    ScreenAdr,
  478.    PageAdr     : integer;
  479. begin
  480.     If Screen[Page] = nil then
  481.     begin
  482.        WinTTT_Error(7);
  483.        exit;
  484.     end
  485.     else
  486.        W_error := 0;
  487.     Width := succ(X2- X1);
  488.     For I :=  Y1 to Y2 do
  489.     begin
  490.         ScreenAdr := pred(Y+I-Y1)*160 + Pred(X)*2;
  491.         PageAdr   := Pred(I)*160 + Pred(X1)*2;
  492.         MoveToScreen(Mem[Seg(Screen[Page]^.ScreenPtr^):ofs(Screen[Page]^.ScreenPtr^)+PageAdr],
  493.                      Mem[BaseOfScreen:ScreenAdr],
  494.                      width);
  495.     end;
  496. end;
  497.  
  498. Procedure SlideRestoreScreen(Page:byte;Way:Direction);
  499. {Display a screen that was previously saved, with fancy slide}
  500. Var I : byte;
  501. begin
  502.     If Screen[Page] = nil then
  503.     begin
  504.        WinTTT_Error(7);
  505.        exit;
  506.     end
  507.     else
  508.        W_error := 0;
  509.     Case Way of
  510.     Up    : begin
  511.                 For I := DisplayLines downto 1 do
  512.                 begin
  513.                     PartRestoreScreen(Page,
  514.                                       1,1,80,succ(DisplayLines -I),
  515.                                       1,I);
  516.                     Delay(50);
  517.                 end;
  518.             end;
  519.     Down  : begin
  520.                 For I := 1 to DisplayLines do
  521.                 begin
  522.                     PartRestoreScreen(Page,
  523.                                       1,succ(DisplayLines -I),80,DisplayLines,
  524.                                       1,1);
  525.                     Delay(50);  {savor the moment!}
  526.                 end;
  527.             end;
  528.     Left  : begin
  529.                 For I := 1 to 80 do
  530.                 begin
  531.                     PartRestoreScreen(Page,
  532.                                       1,1,I,DisplayLines,
  533.                                       succ(80-I),1);
  534.                 end;
  535.             end;
  536.     Right : begin
  537.                 For I := 80 downto 1 do
  538.                 begin
  539.                     PartRestoreScreen(Page,
  540.                                       I,1,80,DisplayLines,
  541.                                       1,1);
  542.                 end;
  543.             end;
  544.     end; {case}
  545.     PosCursor(Screen[Page]^.CursorX,Screen[Page]^.CursorY);
  546.     SizeCursor(Screen[Page]^.ScanTop,Screen[Page]^.ScanBot);
  547. end;   {Proc SlideRestoreScreen}
  548.  
  549.  
  550. Procedure PartSlideRestoreScreen(Page:byte;Way:Direction;X1,Y1,X2,Y2:byte);
  551. {Display a screen that was previously saved, with fancy slide}
  552. Var I : byte;
  553. begin
  554.     If Screen[Page] = nil then
  555.     begin
  556.        WinTTT_Error(7);
  557.        exit;
  558.     end
  559.     else
  560.        W_error := 0;
  561.     Case Way of
  562.     Up    : begin
  563.                 For I := Y2 downto Y1 do
  564.                 begin
  565.                     PartRestoreScreen(Page,
  566.                                       X1,Y1,X2,Y1+Y2-I,
  567.                                       X1,I);
  568.                     Delay(50);
  569.                 end;
  570.             end;
  571.     Down  : begin
  572.                 For I := Y1 to Y2 do
  573.                 begin
  574.                     PartRestoreScreen(Page,
  575.                                       X1,Y1+Y2 -I,X2,Y2,
  576.                                       X1,Y1);
  577.                     Delay(50);  {savor the moment!}
  578.                 end;
  579.             end;
  580.     Left  : begin
  581.                 For I := X1 to X2 do
  582.                 begin
  583.                     PartRestoreScreen(Page,
  584.                                       X1,Y1,I,Y2,
  585.                                       X1+X2-I,Y1);
  586.                 end;
  587.             end;
  588.     Right : begin
  589.                 For I := X2 downto X1 do
  590.                 begin
  591.                     PartRestoreScreen(Page,
  592.                                       I,Y1,X2,Y2,
  593.                                       X1,Y1);
  594.                 end;
  595.             end;
  596.     end; {case}
  597. end;   {Proc PartSlideRestoreScreen}
  598.  
  599.  
  600. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  601. {                                                                              }
  602. {     V I R T U A L    S C R E E N    S P E C I F I C   P R O C E D U R E S    }
  603. {                                                                              }
  604. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  605.  
  606. Procedure Clear_Vscreen(page:byte);
  607. var
  608.    Tseg, Tofs : word;
  609. begin
  610.     If Screen[Page] = nil then
  611.     begin
  612.        WinTTT_Error(8);
  613.        exit;
  614.     end
  615.     else
  616.        W_error := 0;
  617.     Tseg := Vseg;
  618.     Tofs := Vofs;
  619.     Vseg := Seg(Screen[Page]^.ScreenPtr^);
  620.     Vofs := Ofs(Screen[Page]^.ScreenPtr^);
  621.     ClearText(1,1,80,Screen[Page]^.SavedLines,yellow,black);
  622.     Vseg := Tseg;
  623.     Vofs := Tofs;
  624. end;
  625.  
  626. Procedure CreateScreen(Page:byte;Lines:byte);
  627. begin
  628.     W_error := 0;
  629.     If (Page > Max_Screens) then
  630.     begin
  631.        WinTTT_Error(1);
  632.        exit;
  633.     end;
  634.     If ((Screen[Page] <> nil) and (Lines <> Screen[Page]^.SavedLines)) then
  635.         DisposeScreen(Page);
  636.     If Screen[Page] = nil then            {need to allocate memory}
  637.     begin
  638.         If MaxAvail < SizeOf(Screen[Page]^) then
  639.         begin
  640.             WinTTT_Error(3);
  641.             exit;
  642.         end;
  643.         GetMem(Screen[Page],SizeOf(Screen[Page]^));
  644.         If MaxAvail < Lines*160 then     {do check in two parts 'cos Maxavail is not same as MemAvail}
  645.         begin
  646.             WinTTT_Error(3);
  647.             Freemem(Screen[Page],SizeOf(Screen[Page]^));
  648.             Screen[Page] := nil;
  649.             exit;
  650.         end;
  651.         GetMem(Screen[Page]^.ScreenPtr,Lines*160);
  652.         Inc(ScreenCounter);
  653.     end;
  654.     With Screen[Page]^ do
  655.     begin
  656.         If BaseOfScreen = $B000 then
  657.         begin
  658.             ScanTop := 12;
  659.             ScanBot := 13;
  660.         end
  661.         else
  662.         begin
  663.             ScanTop := 6;
  664.             ScanBot := 7;
  665.         end;
  666.         CursorX := 1;
  667.         CursorY := 1;
  668.         SavedLines := Lines;
  669.         Clear_Vscreen(Page);
  670.     end;
  671. end;
  672.  
  673. Procedure Activate_Visible_Screen;
  674. begin
  675.     VSeg := BaseOfScreen;
  676.     VOfs := 0;
  677.     ActiveVscreen := 0;
  678. end;
  679.  
  680. Procedure Activate_Virtual_Screen(Page:byte);
  681. {Page zero signifies the visible screen}
  682. begin
  683.     If Screen[Page] = nil then
  684.        WinTTT_Error(4)
  685.     else
  686.     begin
  687.        W_error := 0;
  688.        If Page = 0 then
  689.           Activate_Visible_Screen
  690.        else
  691.        begin
  692.            VSeg := Seg(Screen[Page]^.ScreenPtr^);
  693.            VOfs := Ofs(Screen[Page]^.ScreenPtr^);
  694.            ActiveVScreen := page;
  695.        end;
  696.     end;
  697. end;
  698.  
  699. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  700. {                                                                              }
  701. {     V I S I B L E    S C R E E N    S P E C I F I C   P R O C E D U R E S    }
  702. {                                                                              }
  703. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  704.  
  705. Procedure SetCondensedLines;
  706. begin
  707.     If EGAVGASystem then
  708.     begin
  709.         W_Error := 0;
  710.         TextMode(Lo(LastMode)+Font8x8);
  711.         DisplayLines := succ(Hi(WindMax));
  712.     end
  713.     else
  714.         W_Error := 12;
  715. end;  {proc SetCondensedDisplay}
  716.  
  717. Procedure Set25Lines;
  718. begin
  719.     TextMode(Lo(LastMode));
  720.     DisplayLines := succ(Hi(WindMax));
  721. end;
  722.  
  723.  
  724. Procedure CopyScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  725. {copies text and attributes from one part of screen to another}
  726. Var
  727.    S : word;
  728.    SPtr : pointer;
  729. begin
  730.     W_error := 0;
  731.     S := succ(Y2-Y1)*succ(X2-X1)*2;
  732.     If Maxavail < S then
  733.        WinTTT_Error(9)
  734.     else
  735.     begin
  736.         GetMem(SPtr,S);
  737.         PartSave(X1,Y1,X2,Y2,SPtr^);
  738.         PartRestore(X,Y,X+X2-X1,Y+Y2-Y1,SPtr^);
  739.         FreeMem(Sptr,S);
  740.     end;
  741. end; {CopyScreenBlock}
  742.  
  743. Procedure MoveScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  744. {Moves text and attributes from one part of screen to another,
  745.  replacing with Replace_Char}
  746. const
  747.   Replace_Char = ' ';
  748. Var
  749.    S : word;
  750.    SPtr : pointer;
  751.    I : Integer;
  752.    ST : string;
  753. begin
  754.     W_error := 0;
  755.     S := succ(Y2-Y1)*succ(X2-X1)*2;
  756.     If Maxavail < S then
  757.        WinTTT_Error(9)
  758.     else
  759.     begin
  760.         GetMem(SPtr,S);
  761.         PartSave(X1,Y1,X2,Y2,SPtr^);
  762.         St := Replicate(succ(X2-X1),Replace_Char);
  763.         For I := Y1 to Y2 do
  764.             PlainWrite(X1,I,St);
  765.         PartRestore(X,Y,X+X2-X1,Y+Y2-Y1,SPtr^);
  766.         FreeMem(Sptr,S);
  767.     end;
  768. end; {Proc MoveScreenBlock}
  769.  
  770. Procedure Scroll(Way:direction;X1,Y1,X2,Y2:byte);
  771. {used for screen scrolling, uses Copy & Plainwrite for speed}
  772. const
  773.   Replace_Char = ' ';
  774. var
  775.   I : integer;
  776. begin
  777.     W_error := 0;
  778.     Case Way of
  779.     Up   : begin
  780.                CopyScreenBlock(X1,succ(Y1),X2,Y2,X1,Y1);
  781.                PlainWrite(X1,Y2,replicate(succ(X2-X1),Replace_Char));
  782.            end;
  783.     Down : begin
  784.                CopyScreenBlock(X1,Y1,X2,pred(Y2),X1,succ(Y1));
  785.                PlainWrite(X1,Y1,replicate(succ(X2-X1),Replace_Char));
  786.            end;
  787.     Left : begin
  788.                CopyScreenBlock(succ(X1),Y1,X2,Y2,X1,Y1);
  789.                For I := Y1 to Y2 do
  790.                    PlainWrite(X2,I,Replace_Char);   {5.01}
  791.            end;
  792.     Right: begin
  793.                CopyScreenBlock(X1,Y1,pred(X2),Y2,succ(X1),Y1);
  794.                For I := Y1 to Y2 do
  795.                    PlainWrite(X1,I,Replace_Char);   {5.01}
  796.            end;
  797.     end; {case}
  798. end;
  799.  
  800. procedure CreateWin(x1,y1,x2,y2,F,B,boxtype:integer);
  801. {called by MkWin and GrowMkWin}
  802. begin
  803.     If WindowCounter >= Max_Windows then
  804.     begin
  805.        WinTTT_Error(2);
  806.        exit;
  807.     end;
  808.     If MaxAvail < sizeOf(Win[WindowCounter]^) then
  809.     begin
  810.        WinTTT_Error(3);
  811.        exit;
  812.     end
  813.     else
  814.        W_error := 0;
  815.     Inc(WindowCounter);
  816.     GetMem(Win[WindowCounter],sizeof(Win[WindowCounter]^));    {allocate space}
  817.     If (BoxType in [5..9]) and (X1 > 1) then     {is there a drop shadow}
  818.     begin
  819.         X1 := pred(X1);    {increase dimensions for the box}
  820.         Y2 := succ(Y2);
  821.     end;
  822.     If MaxAvail < succ(Y2-Y1)*succ(X2-X1)*2 then
  823.     begin
  824.        WinTTT_Error(3);
  825.        exit;
  826.     end;
  827.     GetMem(Win[WindowCounter]^.ScreenPtr,succ(Y2-Y1)*succ(X2-X1)*2);
  828.     PartSave(X1,Y1,X2,Y2,Win[WindowCounter]^.ScreenPtr^);
  829.     with Win[WindowCounter]^ do
  830.     begin
  831.       Coord[1] := X1;
  832.       Coord[2] := Y1;
  833.       Coord[3] := X2;
  834.       Coord[4] := Y2;
  835.       FindCursor(CursorX,CursorY,ScanTop,ScanBot);
  836.     end;  {with}
  837. end; {Proc CreateWin}
  838.  
  839. procedure mkwin(x1,y1,x2,y2,F,B,boxtype:integer);
  840. {Main procedure for creating window}
  841. var I : integer;
  842. begin
  843.     If ActiveVscreen <> 0 then
  844.     begin
  845.         W_error := 10;
  846.         exit;
  847.     end
  848.     else
  849.         W_error := 0;
  850.     CreateWin(X1,Y1,X2,Y2,F,B,Boxtype);
  851.     If (BoxType in [5..9]) and (X1 > 1) then
  852.        FBox(x1,y1,x2,y2,F,B,boxtype-shadow)
  853.     else
  854.        FBox(x1,y1,x2,y2,F,B,boxtype);
  855.     If (BoxType in [5..9]) and (X1 > 1) then     {is there a drop shadow}
  856.     begin
  857.         For I := succ(Y1) to succ(Y2) do
  858.             WriteAt(pred(X1),I,Shadcolor,black,chr(219));
  859.         WriteAt(X1,succ(Y2),Shadcolor,black,
  860.                 replicate(X2-succ(X1),chr(219)));
  861.     end;
  862. end;
  863.  
  864. procedure GrowMKwin(x1,y1,x2,y2,F,B,boxtype:integer);
  865. {same as MKwin but window explodes}
  866. var I : integer;
  867. begin
  868.     If ActiveVscreen <> 0 then
  869.     begin
  870.         W_error := 10;
  871.         exit;
  872.     end
  873.     else
  874.         W_error := 0;
  875.     CreateWin(X1,Y1,X2,Y2,F,B,Boxtype);
  876.     If (BoxType in [5..9]) and (X1 > 1) then
  877.        GrowFBox(x1,y1,x2,y2,F,B,boxtype-shadow)
  878.     else
  879.        GrowFBox(x1,y1,x2,y2,F,B,boxtype);
  880.     If (BoxType in [5..9]) and (X1 > 1) then     {is there a drop shadow}
  881.     begin
  882.         For I := succ(Y1) to succ(Y2) do
  883.             WriteAt(pred(X1),I,Shadcolor,black,chr(219));
  884.         WriteAt(X1,succ(Y2),Shadcolor,black,
  885.                 replicate(X2-succ(X1),chr(219)));
  886.     end;
  887. end;
  888.  
  889. Procedure RmWin;
  890. begin
  891.     If ActiveVscreen <> 0 then
  892.     begin
  893.         W_error := 10;
  894.         exit;
  895.     end
  896.     else
  897.         W_error := 0;
  898.     If WindowCounter > 0 then
  899.     begin
  900.         with  Win[WindowCounter]^ do
  901.         begin
  902.             PartRestore(Coord[1],Coord[2],Coord[3],Coord[4],ScreenPtr^);
  903.             PosCursor(CursorX,CursorY);
  904.             SizeCursor(ScanTop,ScanBot);
  905.             FreeMem(ScreenPtr,succ(Coord[4]-coord[2])*succ(coord[3]-coord[1])*2);
  906.             FreeMem(Win[WindowCounter],sizeof(Win[WindowCounter]^));
  907.         end; {with}
  908.         Dec(WindowCounter);
  909.     end;
  910. end;
  911.  
  912. procedure TempMessageCh(X,Y,F,B:integer;St:strscreen;var Ch : char);
  913. var
  914.  CX,CY,CT,CB,I,locC:integer;
  915.  SavedLine : array[1..160] of byte;
  916. begin
  917.     If ActiveVscreen <> 0 then
  918.     begin
  919.         W_error := 11;
  920.         exit;
  921.     end
  922.     else
  923.         W_error := 0;
  924.     PartSave(X,Y,pred(X)+length(St),Y,SavedLine);
  925.     WriteAT(X,Y,F,B,St);
  926.     Ch := GetKey;
  927.     PartRestore(X,Y,pred(X)+length(St),Y,SavedLine);
  928. end;
  929.  
  930. Procedure TempMessage(X,Y,F,B:integer;St:strscreen);
  931. var Ch : char;
  932. begin
  933.     TempMessageCH(X,Y,F,B,ST,Ch);
  934. end;              
  935.  
  936. Procedure TempMessageBoxCh(X1,Y1,F,B,BoxType:integer;St:strscreen;var Ch : char);
  937. begin
  938.     If ActiveVscreen <> 0 then
  939.     begin
  940.         W_error := 11;
  941.         exit;
  942.     end
  943.     else
  944.         W_error := 0;
  945.     MkWin(X1,Y1,succ(X1)+length(St),Y1+2,F,B,Boxtype);
  946.     WriteAt(succ(X1),Succ(Y1),F,B,St);
  947.     Ch := getKey;
  948.     Rmwin;
  949. end;
  950.  
  951. Procedure TempMessageBox(X1,Y1,F,B,BoxType:integer;St:strscreen);
  952. var Ch : char;
  953. begin
  954.     TempMessageBoxCh(X1,Y1,F,B,Boxtype,St,Ch);
  955. end;
  956.  
  957. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  958.  
  959. Procedure InitWinTTT;
  960. {set Pointers to nil for validity checking}
  961. Var
  962.   I : integer;
  963.   X,Y : byte;
  964. begin
  965.     For I := 1 to Max_Screens do
  966.         Screen[I] := nil;
  967.     StartMode := LastMode;           { record the initial state of screen when program was executed}
  968.     DisplayLines := succ(Hi(WindMax));
  969.     FindCursor(X,Y,StartTop,StartBot);
  970. end;
  971.  
  972.  
  973. Procedure Reset_StartUp_Mode;
  974. {resets monitor mode and cursor settings to the state they
  975.  were in at program startup}
  976. begin
  977.     TextMode(StartMode);
  978.     SizeCursor(StartTop,StartBot);
  979. end; {proc StartUp_Mode}
  980.  
  981. begin
  982.     InitWinTTT;
  983.     W_error := 0;
  984.     W_fatal := false;   {don't terminate program if fatal error}
  985.     Shadcolor := darkgray;
  986. end.
  987.